home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
stay42.zip
/
STAYWNDO.341
< prev
next >
Wrap
Text File
|
1986-06-07
|
16KB
|
376 lines
{**********************************************************************}
{ W I N D O . I N C }
{ "...but I dont do floors !" }
{**********************************************************************}
{ Kloned and Kludged by Lane Ferris }
{ -- The Hunters Helper -- }
{ Original Copyright 1984 by Michael A. Covington }
{ Modifications by Lynn Canning 9/25/85 }
{ 1) Foreground and Background colors added. }
{ Monochrome monitors are automatically set }
{ to white on black. }
{ 2) Multiple borders added. }
{ 3) TimeDelay procedure added. }
{ Requirements: IBM PC or close compatible. }
{----------------------------------------------------------------------}
{ To make a window on the screen, call the procedure }
{ MkWin(x1,y1,x2,y2,FG,BG,BD); }
{ The x and y coordinates define the window placement and are the }
{ same as the Turbo Pascal Window coordinates. }
{ The border parameters (BD) are 0 = No border }
{ 1 = Single line border }
{ 2 = Double line border }
{ 3 = Double Top/Bottom Single sides }
{ The foreground (FG) and background (BG) parameters are the same }
{ values as the corresponding Turbo Pascal values. }
{ }
{ The maximum number of windows open at one time is set at five }
{ (see MaxWin=5). This may be set to greater values if necessary. }
{ }
{ After the window is made, you must write the text desired from the }
{ calling program. Note that the usable text area is actually 1 }
{ position smaller than the window coordinates to allow for the border.}
{ Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24 }
{ after the border is created. When writing to the window in your }
{ calling program, the textcolor and backgroundcolor may be changed as }
{ desired by using the standard Turbo Pascal commands. }
{ }
{ To return to the previous screen or window, call the procedure }
{ RmWin; }
{ }
{ The TimeDelay procedure is invoked from your calling program. It }
{ is similar to the Turbo Pascal DELAY except DELAY is based on clock }
{ speed whereas TimeDelay is based on the actual clock. This means }
{ that the delay will be the same duration on all systems no matter }
{ what the clock speed. }
{ The procedure could be used for an error condition as follows: }
{ MkWin - make an error message window }
{ Writeln - write error message to window }
{ TimeDelay(5) - leave window on screen 5 seconds }
{ RmWin - remove error window }
{ cont processing }
{----------------------------------------------------------------------}
Const
InitDone :boolean = false ; { Initialization switch }
On = True ;
Off = False ;
VideoEnable = $08; { Video Signal Enable Bit }
Bright = 8; { Bright Text bit}
Mono = 7; {MonoChrome Mode}
Type
Imagetype = array [1..4000] of char; { Screen Image in the heap }
WinDimtype = record
x1,y1,x2,y2: integer
end;
Screens = record { Save Screen Information }
Image: Imagetype; { Saved screen Image }
Dim: WinDimtype; { Saved Window Dimensions }
x,y: integer; { Saved cursor position }
end;
Var
Win: { Global variable package }
record
Dim: WinDimtype; { Current Window Dimensions }
Depth: integer;
{ MaxWin should be included in your program }
{ and it should be the number of windows saved }
{ at one time }
{ It should be in the const section of your program }
Stack: array[1..MaxWin] of ^Screens;
end;
Crtmode :byte absolute $0040:$0049; {Crt Mode,Mono,Color,B&W..}
Crtwidth :byte absolute $0040:$004A; {Crt Mode Width, 40:80 .. }
Monobuffer :Imagetype absolute $B000:$0000; {Monochrome Adapter Memory}
Colorbuffer :Imagetype absolute $B800:$0000; {Color Adapter Memory }
CrtAdapter :integer absolute $0040:$0063; { Current Display Adapter }
VideoMode :byte absolute $0040:$0065; { Video Port Mode byte }
TurboCrtMode: byte absolute Dseg:6; {Turbo's Crt Mode byte }
Video_Buffer:integer; { Record the current Video}
Delta,
x,y :integer;
{------------------------------------------------------------------}
{ Delay for X seconds }
{------------------------------------------------------------------}
procedure TimeDelay (hold : integer);
type
RegRec = { The data to pass to DOS }
record
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
end;
var
regs:regrec;
ah, al, ch, cl, dh:byte;
sec :string[2];
result, secn, error, secn2, diff :integer;
begin
ah := $2c; {Get Time-Of-Day from DOS}
with regs do {Will give back Ch:hours }
{Cl:minutes,Dh:seconds }
ax := ah shl 8 + al; {Dl:hundreds }
intr($21,regs);
with regs do
str(dx shr 8:2, sec); {Get seconds }
{with leading null}
if (sec[1] = ' ') then
sec[1]:= '0';
val(sec, secn, error); {Conver seconds to integer}
repeat { stay in this loop until the time }
ah := $2c; { has expired }
with regs do
ax := ah shl 8 + al;
intr($21,regs); {Get current time-of-day}
with regs do {Normalize to Char}
str(dx shr 8:2, sec);
if (sec[1] = ' ') then
sec[1]:= '0';
val(sec, secn2, error); {Convert seconds to integer}
diff := secn2 - secn; {Number of elapsed seconds}
if diff < 0 then { we just went over the minute }
diff := diff + 60; { so add 60 seconds }
until diff > hold; { has our time expired yet }
end; { procedure TimeDelay }
{------------------------------------------------------------------}
{ Get Absolute postion of Cursor into parameters x,y }
{------------------------------------------------------------------}
Procedure Get_Abs_Cursor (var x,y :integer);
Var
Active_Page : byte absolute $0040:$0062; { Current Video Page Index}
Crt_Pages : array[0..7] of integer absolute $0040:$0050 ;
Begin
X := Crt_Pages[active_page]; { Get Cursor Position }
Y := Hi(X)+1; { Y get Row }
X := Lo(X)+1; { X gets Col position }
End;
{------